home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / umind.arc / SKELETON.MRG < prev    next >
Encoding:
Text File  |  1984-01-07  |  8.5 KB  |  123 lines
  1. 44999 ' Merge this in with the bad copy of SKELETON.BAS
  2. 45000 REM ************************************************************
  3. 45001 REM *** Search and List Function     Process: Look for records matching
  4. 45002 REM ***                                       any specified parameters
  5. 45003 REM ***                                       and display them
  6. 45004 REM ************************************************************
  7. 45010 LOCATE 25,1:PRINT STRING$(79,32);:LOCATE 25,1:A$="Enter record # to start search or <ENTER> to start at current record ":PRINT A$;
  8. 45020 ROW=25:COLUMN=LEN(A$)+2:A1%=LEN(STR$(MAXSIZE)):AX$="0123456789":GOSUB 40130:RECNUM=VAL(AN$)
  9. 45030 IF RECNUM<>0 GOTO 45050 ELSE IF CURRENT=-1 THEN RECNUM=1:GOTO 45060
  10. 45040 RECNUM=CURRENT:GOTO 45060
  11. 45050 IF RECNUM>MAXSIZE THEN RECNUM=1
  12. 45060 LOCATE 25,1:PRINT STRING$(79,32);:LOCATE 25,1:A$="Do you wish to display records that have been deleted (Y/N)? ":PRINT A$;
  13. 45070 ROW=25:COLUMN=LEN(A$)+2:AX$="YyNn":A1%=1:GOSUB 40130:IF AN$="" GOTO 45060
  14. 45080 DEL$=AN$
  15. 45090 LOCATE 25,1:PRINT STRING$(79,32);:LOCATE 25,1:A$="Do you wish to select by a field's contents (Y/N)? ":PRINT A$;
  16. 45100 ROW=25:COLUMN=LEN(A$)+2:AX$="YyNn":A1%=1:GOSUB 40130:IF AN$="" GOTO 45090
  17. 45110 TEST$=AN$:IF TEST$="N" OR TEST$="n" GOTO 45200 ELSE LOCATE 25,1:PRINT STRING$(79,32);
  18. 45120 LOCATE 25,1:A$="Enter field number to test ":PRINT A$;:ROW=25:COLUMN=LEN(A$)+2:AX$="0123456789":A1%=LEN(STR$(NF)):GOSUB 40130:IF AN$="" GOTO 45120 ELSE FL=VAL(AN$):PAGE=0:GOSUB 2000
  19. 45130 LOCATE 25,1:PRINT STRING$(79,32);:A$="Enter test string":LOCATE 25,1:PRINT A$;:ROW=25:COLUMN=LEN(A$)+2:AX$=AQ$:A1%=35:GOSUB 40130:IF AN$="" GOTO 45130
  20. 45140 COMPARE$=RIGHT$(AN$,LEN(AN$)-1):TYPE$=LEFT$(AN$,1):IF TYPE$<>"<" AND TYPE$<>">" AND TYPE$<>"=" GOTO 45130
  21. 45200 GOSUB 32000:IF STAT$="E" GOTO 45300
  22. 45210 IF STAT$<>"D" GOTO 45220
  23. 45215 IF DEL$="N" OR DEL$="n" GOTO 45300
  24. 45220 IF TEST$="Y" OR TEST$="y" GOTO 45400
  25. 45230 GOSUB 17000:PAGE=1:FL=0:GOSUB 2000:GOSUB 7000:LOCATE 25,1:PRINT STRING$(79,32);:IF STAT$="A" THEN S$="Active" ELSE S$="Deleted"
  26. 45240 A$="Status: "+S$+": Continue search (Y/N)":LOCATE 25,1:PRINT A$;:ROW=25:COLUMN=LEN(A$)+2:A1%=1:AX$="YyNn":GOSUB 40130:IF AN$="Y" OR AN$="y" GOTO 45300
  27. 45250 IF AN$="" GOTO 45240 ELSE IF STAT$="D" GOTO 38000
  28. 45260 CURRENT=RECNUM:GOTO 37000
  29. 45300 RECNUM=RECNUM+1:IF RECNUM>MAXSIZE THEN CURRENT=-1:RETURN
  30. 45310 GOTO 45200
  31. 45400 GOSUB 17000:IF TYPE$<>"<" GOTO 45500
  32. 45410 IF LEFT$(F$(FL),LEN(COMPARE$))=COMPARE$ GOTO 45230
  33. 45420 GOTO 45300
  34. 45500 IF TYPE$<>">" GOTO 45600
  35. 45510 FOR A=1 TO LEN(F$(FL))-LEN(COMPARE$)
  36. 45520 IF MID$(F$(FL),A,LEN(COMPARE$))=COMPARE$ GOTO 45230
  37. 45530 NEXT A:GOTO 45300
  38. 45600 IF F$(FL)=COMPARE$ GOTO 45230
  39. 45610 GOTO 45300
  40. 46000 REM ************************************************************
  41. 46001 REM *** X-tend Work To New Disk Function  Process: Prompt for new
  42. 46002 REM ***                                            data disk mount, then
  43. 46003 REM ***                                            read in MAXSIZE from
  44. 46004 REM ***                                            .DEF file and return
  45. 46005 REM ***                                            to caller
  46. 46006 REM ************************************************************
  47. 46010 CURRENT=-1:LOCATE 25,1:PRINT STRING$(79,32);:A$="Mount data disk in drive "+LEFT$(NA$,1)+", then press <C> to continue":LOCATE 25,1:PRINT A$;
  48. 46020 ROW=25:COLUMN=LEN(A$)+2:AX$="Cc":A1%=1:GOSUB 40130:IF AN$="" GOTO 46010
  49. 46030 IN=2:OPEN "I",#2,NA$+".DEF":INPUT#2,MAXSIZE,GOOD:CLOSE:OPEN "i",1,NA$+".vol":INPUT#1,V$:CLOSE:OPEN "r",1,NA$+".DAT",SIZE:IN=0:RETURN
  50. 46100 IN=0:LOCATE 25,1:PRINT STRING$(79,32);:GOSUB 47000:GOTO 46000
  51. 47000 REM ************************************************************
  52. 47001 REM *** Initialize New Data Disk Function  Process: Write records to data
  53. 47002 REM ***                                             disk until error
  54. 47003 REM ***                                             occurs.  Error
  55. 47004 REM ***                                             routine will then
  56. 47005 REM ***                                             branch back to line
  57. 47006 REM ***                                             47500 where ".DEF"
  58. 47007 REM ***                                             file is written.
  59. 47008 REM ************************************************************
  60. 47010 CLOSE:CURRENT=-1:IN=1:LOCATE 25,1:PRINT STRING$(79,32);:A$="S)pecify number of records, or U)se all available disk space? ":LOCATE 25,1:PRINT A$;
  61. 47020 ROW=25:COLUMN=LEN(A$)+2:AX$="SsUu":A1%=1:GOSUB 40130:IF AN$="" GOTO 47020
  62. 47030 IF AN$="U" OR AN$="u" GOTO 47100 ELSE LOCATE 25,1:PRINT STRING$(79,32);:A$="How many data records?":LOCATE 25,1:PRINT A$;
  63. 47040 ROW=25:COLUMN=LEN(A$)+2:AX$="0123456789":A1%=6:GOSUB 40130:NU=VAL(AN$):IF AN$="" OR NU=0 GOTO 47030
  64. 47050 GOTO 47110
  65. 47060 LOCATE 25,1:PRINT STRING$(79,32);:LOCATE 25,1:A$="Enter volume name:":PRINT A$;:ROW=25:COLUMN=LEN(A$)+2:AX$=AQ$:A1%=25:GOSUB 40130:V$=AN$:IF AN$="" GOTO 47060
  66. 47070 OPEN "o",1,NA$+".VOL":PRINT#1,V$:CLOSE:RETURN
  67. 47100 NU=-1
  68. 47110 GOSUB 47060:OPEN "o",2,NA$+".DEF":PRINT#2,100000!,100000!:CLOSE
  69. 47120 OPEN "R",#1,NA$+".DAT",SIZE
  70. 47125 STAT1$="E":FOR Z=1 TO NF:F$(Z)=STRING$(80,32):NEXT Z:GOSUB 12000
  71. 47140 CT=1
  72. 47150 LOCATE 25,1:PRINT STRING$(79,32);
  73. 47160 A$="Stand by... Initializing record #":LOCATE 25,1:PRINT A$;
  74. 47200 LOCATE 25,LEN(A$)+1:PRINT CT;:PUT 1,CT
  75. 47210 CT=CT+1:IF NU=-1 GOTO 47200 ELSE NU=NU-1
  76. 47220 IF NU=0 GOTO 47500 ELSE GOTO 47200
  77. 47500 CLOSE:CT=CT-1:OPEN "O",#2,NA$+".DEF":PRINT#2,CT,0:CLOSE #2
  78. 47510 IN=0:LOCATE 25,1:PRINT STRING$(79,32);:RETURN
  79. 49000 REM ************************************************************
  80. 49001 REM *** BASIC Error Handler         Process: This is really only set
  81. 49002 REM ***                                      up to handle the DISK
  82. 49003 REM ***                                      SPACE full error when
  83. 49004 REM ***                                      initializing a new data
  84. 49005 REM ***                                      disk indicated by variable
  85. 49006 REM ***                                      IN = 1.  Otherwise ERROR
  86. 49007 REM ***                                      code is reported, files are
  87. 49008 REM ***                                      closed, and program ends.
  88. 49009 REM ************************************************************
  89. 49010 IF IN=0 GOTO 49100
  90. 49020 IF IN=1 AND ERR=61 THEN RESUME 47500
  91. 49030 IF IN=2 AND ERR=53 THEN RESUME 46100
  92. 49100 CLS:RESET:PRINT "Internal ERROR #";ERR;" in line #";ERL:PRINT"Consult BASIC manual appendix A for explanation.":END
  93. 50000 REM ************************************************************
  94. 50001 REM *** Program Title Display Function     Process: Used to display
  95. 50002 REM ***                                             program title and
  96. 50003 REM ***   Display idea credit to:                   author at beginning
  97. 50004 REM ***      John Vandergrift                       and end of program
  98. 50005 REM ***                                             execution.
  99. 50006 REM ************************************************************
  100. 50010 BEEP:CLS:A$=TI$:A1$="B":A2$="Y":A3$=AU$:C=10
  101. 50020 GOSUB 50060
  102. 50030 A$=STRING$(LEN(A$)," "):A1$=" ":A2$=" ":A3$=STRING$(LEN(A3$)," "):C=9
  103. 50040 GOSUB 50060
  104. 50050 FOR Z=1 TO 2000:NEXT Z:RETURN
  105. 50060 FOR I=1 TO C
  106. 50070 LOCATE I,40-LEN(A$)/2:PRINT A$;
  107. 50080 LOCATE 12,4*I:PRINT A1$;
  108. 50090 LOCATE 12,81-(4*I):PRINT A2$;
  109. 50100 LOCATE 24-I,41-(LEN(A3$)/2):PRINT A3$;
  110. 50110 NEXT I
  111. 50120 RETURN
  112. 60000 REM *** Do not remove lines 60000 through 60009!
  113. 60001 REM *** This program SKELETON.BAS is to be used with the Ultra-Mind
  114. 60002 REM *** intelligent database program generator.  It is copyright, (C),
  115. 60003 REM *** 1983, by The FreeSoft Company, P.O. Box 27608, St. Louis, MO
  116. 60004 REM *** 63146.  For copies of this and the other Ultra-Utility programs,
  117. 60005 REM *** send 2 double sided or 4 single sided diskettes and a postage
  118. 60006 REM *** paid self addressed return mailer to the address above.  Specify
  119. 60007 REM *** that you want LIBRARIES #1 and #2.  The Ultra-Utilities include
  120. 60008 REM *** Ultra-Zap, Ultra-Format, Ultra-File, Ultra-Optimize, and
  121. 60009 REM *** Ultra-Mind.  Lines 60000 through 60009 all be removed from all
  122. 60010 REM *** programs generated by Ultra-Mind.
  123.